home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
v9n03.arc
/
PIANO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-01-12
|
6KB
|
190 lines
PIANO.PAS
PROGRAM Piano;
USES CRT;
VAR
vari : Integer;
test, dly, intern, dlykeep : LongInt;
flager, chartoplay : Char;
numb, octave : Integer;
typom, min1, adder : Real;
PROCEDURE Play(SoundC : STRING);
FUNCTION IsNumber(ch : CHAR) : Boolean;
BEGIN
IsNumber := (CH >= '0') AND (CH <= '9');
END;
FUNCTION value(s : STRING) : Integer;
{Converts a string to an integer}
VAR ss, sss : Integer;
BEGIN
Val(s, ss, sss);
value := ss;
END;
PROCEDURE sounder(key : Char; flag : Char);
{Plays the selected note}
VAR
old, New, new2 : Real;
BEGIN
adder := 1;
old := dly; New := dly;
intern := Pos(key, 'C D EF G A B')-1;
IF (flag = '+') AND (key <> 'E') AND (key <> 'B') {See if note}
THEN Inc(intern); {is sharped }
IF (flag = '-') AND (key <> 'F') AND (key <> 'C')
THEN Dec(intern); {or a flat. }
WHILE SoundC[vari+1] = '.' DO
BEGIN
Inc(vari);
adder := adder/2;
New := New+(old*adder);
END;
new2 := (New/typom)*(1-typom);
sound(Round(Exp((octave+intern/12)*Ln(2)))); {Play the note}
Delay(Trunc(New));
Nosound;
Delay(Trunc(new2));
END;
FUNCTION delayer1 : Integer;
{Calculate delay for a specified note length}
BEGIN
numb := value(SoundC[vari+1]);
delayer1 := Trunc((60000/(numb*min1))*typom);
END;
FUNCTION delayer2 : Integer;
{Used as above, except reads a number >10}
BEGIN
numb := value(SoundC[vari+1]+SoundC[vari+2]);
delayer2 := Trunc((60000/(numb*min1))*typom);
END;
BEGIN {Play}
SoundC := SoundC+' ';
FOR vari := 1 TO Length(SoundC) DO
BEGIN {Go through entire string}
SoundC[vari] := Upcase(SoundC[vari]);
{^Get a char and convert to CAPS}
CASE SoundC[vari] OF
'C','D','E','F','G','A','B' : BEGIN
{^Check to see if char is a note}
flager := ' '; dlykeep := dly;
chartoplay := SoundC[vari];
IF (SoundC[vari+1] = '-') OR (SoundC[vari+1] = '+')
THEN
BEGIN {Check for flats & sharps}
flager := SoundC[vari+1];
Inc(vari);
END;
IF IsNumber(SoundC[vari+1]) THEN
BEGIN
IF IsNumber(SoundC[vari+2]) THEN
BEGIN
test := delayer2;
IF numb < 65 THEN dly := test; {Make sure # is legal}
Inc(vari, 2);
END
ELSE
BEGIN
test := delayer1;
IF numb > 0 THEN dly := test; {Make sure # is legal}
Inc(vari);
END;
END;
sounder(chartoplay, flager);
dly := dlykeep;
END;
'O' : BEGIN {Check for octave change}
Inc(vari);
CASE SoundC[vari] OF
'-' : IF octave > 1 THEN Dec(octave);
'+' : IF octave < 7 THEN Inc(octave);
'1','2','3','4','5','6','7' : octave := value(SoundC[vari])+4;
ELSE Dec(vari);
END;
END;
{Check for a change in length for notes}
'L' : IF IsNumber(SoundC[vari+1]) THEN
BEGIN
IF IsNumber(SoundC[vari+2]) THEN
BEGIN
test := delayer2;
IF numb < 65 THEN dly := test; {Make sure # is legal}
Inc(vari, 2);
END
ELSE
BEGIN
test := delayer1;
IF numb > 0 THEN dly := test; {Make sure # is legal}
Inc(vari);
END;
END;
{Check for a pause and it's length}
'P' : IF IsNumber(SoundC[vari+1]) THEN
BEGIN
IF IsNumber(SoundC[vari+2]) THEN
BEGIN
test := delayer2;
IF numb < 65 THEN Delay(test); {Make sure # is legal}
Inc(vari, 2);
END
ELSE
BEGIN
test := delayer1;
IF numb > 0 THEN Delay(test); {Make sure # is legal}
Inc(vari);
END;
END;
{Check for tempo change}
'T' : IF IsNumber(SoundC[vari+1]) AND IsNumber(SoundC[vari+2]) THEN
BEGIN
IF IsNumber(SoundC[vari+3]) THEN
BEGIN
min1 := value(SoundC[vari+1]+SoundC[vari+2]+SoundC[vari+3]);
Inc(vari, 3);
IF min1 > 255 THEN min1 := 255; {Make sure # isn't too big}
END
ELSE
BEGIN
min1 := value(SoundC[vari+1]+SoundC[vari+2]);
IF min1 < 32 THEN min1 := 32; {Make sure # isn't too short}
END;
min1 := min1/4;
END;
{Check for music type}
'M' : BEGIN
Inc(vari);
CASE Upcase(SoundC[vari]) OF
'N' : typom := 7/8; {Normal}
'L' : typom := 1; {Legato}
'S' : typom := 3/4; {Staccato}
END;
END;
END;
END;
END;
BEGIN {Play Jingle Bells}
Play('T255MNO5L4');
Play('CAGFC2.P4C8C8CAGFD2.P4DB-AGE2.P4O6CCO5B-GA2.P4CAGFC2.');
Play('P4CAGFD2P4DDB-AGO6CCCCDCO5B-GF2O6C2O5');
Play('AAA2AAA2AO6CO5F.G8A2.P4B-B-B-.B-8B-AAA8A8');
Play('AGGAG2O6C2O5');
Play('AAA2AAA2AO6CO5F.G8A2.P4B-B-B-.B-8B-AAA8A8');
Play('O6CCO5B-GF2.');
END. {PIANO}